home *** CD-ROM | disk | FTP | other *** search
/ Varios Español / Varios Español.iso / CLIPP52 / TCBLLIB2.ZIP / DBUEDIT.PRG < prev    next >
Text File  |  1993-04-21  |  23KB  |  1,125 lines
  1. /***
  2. *
  3. *  Dbuedit.prg
  4. *
  5. *  DBU Data File Editing Module
  6. *
  7. *  Copyright (c) 1990-1993, Computer Associates International, Inc.
  8. *  All rights reserved.
  9. *
  10. */
  11.  
  12. #include "inkey.ch"
  13. #include "memoedit.ch"
  14.  
  15. #define TB_REFRESH_RATE    5     // Wait 5 seconds between tbrowse refreshes
  16.  
  17.  
  18. /***
  19. *    browse
  20. *
  21. *    browse one file or the entire View
  22. */
  23. proc browse
  24.  
  25. local i,j,nHelpSave,cNtx,cFieldArray,cFieldName,nWa,cMemo,oB,nRec,;
  26.     cBrowseBuf,nPrimeArea,nHsepRow,cEditField,bAlias,cAlias,nCType,;
  27.     cHead,lMore,lCanAppend,cMemoBuff,aMoveExp,cPrimeDbf,;
  28.    nColorSave,lAppend,lGotKey,lKillAppend,bColBlock
  29.  
  30. /*
  31.  nRefreshTimer forces refresh of browse every TB_REFRESH_RATE seconds
  32.  This serves the purpose of keeping the browse up to date in case we're
  33.  running on a network.
  34. */
  35. local nRefreshTimer  := SECONDS()
  36. local anCursPos[2]
  37.  
  38. memvar keystroke,help_code,func_sel,cur_area,cur_dbf,field_list,frame,;
  39.     curs_on,cur_ntx,ntx1,dbf,local_func,box_open,;
  40.     color1,color7,color8,color9
  41.  
  42.     /* turn off cursor */
  43.     nCType := SetCursor(0)
  44.     curs_on := .f.
  45.  
  46.     /* save prev help code */
  47.     nHelpSave := help_code
  48.  
  49.     /* save, clear, and frame the window */
  50.     cBrowseBuf := SaveScreen(8, 0, 23, 79)
  51.  
  52.     /* array to save move_ptr expressions */
  53.     aMoveExp := Array(4)
  54.     AFill(aMoveExp, "")
  55.  
  56.     /* heading separator row if only one database */
  57.     nHsepRow := 11
  58.  
  59.     /* determine what to browse */
  60.     if ( func_sel == 1 )
  61.         /* browse one file */
  62.         nPrimeArea := cur_area
  63.         cFieldArray := "field_n" + Substr("123456", cur_area, 1)
  64.         cNtx := "ntx" + Substr("123456", cur_area, 1)
  65.         cur_ntx := &cNtx[1]
  66.         cPrimeDbf := Substr(cur_dbf, Rat("\", cur_dbf) + 1)
  67.         lCanAppend := .T.
  68.     else
  69.         /* browse the entire view */
  70.         nPrimeArea := 1
  71.         cFieldArray := "field_list"
  72.         cur_ntx := ntx1[1]
  73.         cPrimeDbf := Substr(dbf[1], Rat("\", dbf[1]) + 1)
  74.         lCanAppend := .F.
  75.  
  76.         if ( "->" $ field_list[afull(field_list)] )
  77.             nHsepRow := 12
  78.         end
  79.     end
  80.  
  81.     /* block to extract alias from alias->field */
  82.     bAlias := &("{|i| if('->' $" + cFieldArray + "[i], Substr(" +;
  83.                 cFieldArray + "[i], 1, At('->'," + cFieldArray +;
  84.                 "[i]) - 1), '')}")
  85.  
  86.     Select(nPrimeArea)
  87.     if ( Eof() )
  88.         /* end of file not allowed */
  89.         go top
  90.     end
  91.  
  92.     /* misc */
  93.     lAppend := .F.
  94.     nRec := 0
  95.  
  96.     /* create TBrowse object */
  97.     nColorSave := SetColor(color7)
  98.  
  99.    IF lIsGraf                //-LLIBG- When in Graphic mode, reduce TBrowse
  100.                              //        area definition to avoid overwiting
  101.                              //        status and message line
  102.       oB := TBrowseDB(10, 1, 22, 78)
  103.    ELSE
  104.       oB := TBrowseDB(10, 1, 23, 78)
  105.    ENDIF
  106.  
  107.     oB:headSep := "═╤═"
  108.     oB:colSep  := " │ "
  109.  
  110.    IF lIsGraf                //-LLB- Don't use foot separators, there's a
  111.                              //      3D look graphic box.
  112.       oB:footSep := ""
  113.    ELSE
  114.       oB:footSep := "═╧═"
  115.    ENDIF
  116.  
  117.     oB:skipBlock := {|x| Skipped(x, lAppend)}
  118.  
  119.     /* put columns into browse */
  120.     j := Len(&cFieldArray)
  121.     for i := 1 TO j
  122.         if ( Empty(&cFieldArray[i]) )
  123.             EXIT
  124.         end
  125.  
  126.         /* determine workarea/alias stuff */
  127.         cEditField := &cFieldArray[i]
  128.         if ( "->" $ cEditField )
  129.             cAlias := Substr(cEditField, 1, At("->", cEditField) + 1)
  130.             cFieldName := Substr(cEditField, At("->", cEditField) + 2)
  131.             cHead := cAlias + ";" + cFieldName
  132.             nWa := Select(cAlias)
  133.         else
  134.             cAlias := ""
  135.             cFieldName := cHead := cEditField
  136.             nWa := Select()
  137.         end
  138.  
  139.         /* memos are handled differently */
  140.         if ( ValType(&cEditField) == "M" )
  141.             bColBlock := &("{|| '  <Memo>  '}")
  142.         else
  143.             bColBlock := FieldWBlock(cFieldName, nWa)
  144.         end
  145.  
  146.         /* add one column */
  147.         oB:addColumn(TBColumnNew(cHead, bColBlock))
  148.     next
  149.  
  150.     /* initialize parts of screen not handled by TBrowse */
  151.     stat_msg("")
  152.     scroll(8, 0, 23, 79, 0)
  153.     @ 8, 0, 23, 79 BOX frame
  154.  
  155.    IF lIsGraf                //-LLIBG- Don't print border caracters, there's a
  156.                              //        3D look graphic box.
  157.    ELSE
  158.       @ nHsepRow, 0 SAY "╞"
  159.       @ nHsepRow, 79 SAY "╡"
  160.    ENDIF
  161.  
  162.     /* init rest of locals */
  163.     cAlias := ""
  164.     lKillAppend := .f.
  165.     if ( (LastRec() == 0) .and. lCanAppend )
  166.         /* empty file..force append mode */
  167.         keystroke := K_DOWN
  168.         lGotKey := .t.
  169.     else
  170.         lGotKey := .f.
  171.     end
  172.  
  173.     lMore := .t.
  174.     while (lMore)
  175.  
  176.         if ( !lGotKey )
  177.             /* keystroke will interrupt stabilize */
  178.             while ( !oB:stabilize() )
  179.                 if ( (keystroke := Inkey()) != 0 )
  180.                     lGotKey := .t.
  181.                     exit
  182.                 end
  183.             end
  184.         end
  185.  
  186.         if ( !lGotKey )
  187.             if ( oB:hitBottom .and. lCanAppend )
  188.                 /* turn on or continue append mode */
  189.                 if ( !lAppend .or. Recno() != LastRec() + 1 )
  190.                     if ( lAppend )
  191.                         /* continue append mode */
  192.                   oB:refreshCurrent():forceStable()
  193.                         go bottom
  194.                     else
  195.                         /* first append */
  196.                         lAppend := .t.
  197.                         SetCursor(1)
  198.                         curs_on := .t.
  199.                     end
  200.  
  201.                     /* move down and stabilize to set rowPos */
  202.                oB:down():forceStable()
  203.                 end
  204.             end
  205.  
  206.             /* display status */
  207.             cAlias := Eval(bAlias, oB:colPos)
  208.             statline(oB, lAppend, cAlias)
  209.  
  210.             /* stabilize again for correct cursor pos */
  211.          WHILE !oB:stabilize() ; END
  212.  
  213.          // If TB_REFRESH_RATE seconds has elapsed, refresh the browse
  214.          // This is neccessary on a network environment to insure updated
  215.          // browses for each user
  216.          WHILE (( keystroke := INKEY()) == 0 )
  217.             IF (( nRefreshTimer + TB_REFRESH_RATE ) < SECONDS() )
  218.                DISPBEGIN()
  219.                anCursPos := { ROW(), COL() }
  220.                FreshOrder( oB )
  221.                StatLine( oB, lAppend, cAlias )
  222.                SETPOS( anCursPos[1], anCursPos[2] )
  223.                DISPEND()
  224.                nRefreshTimer := SECONDS()
  225.             ENDIF
  226.          END
  227.  
  228.         else
  229.             /* reset for next loop */
  230.             lGotKey := .f.
  231.         end
  232.  
  233.         do case
  234.         case keystroke == K_DOWN
  235.             if ( lAppend )
  236.                 oB:hitBottom := .t.
  237.             else
  238.                 oB:down()
  239.             end
  240.  
  241.         case keystroke == K_UP
  242.             if ( lAppend )
  243.                 lKillAppend := .t.
  244.             else
  245.                 oB:up()
  246.             end
  247.  
  248.         case keystroke == K_PGDN
  249.             if ( lAppend )
  250.                 oB:hitBottom := .t.
  251.             else
  252.                 oB:pageDown()
  253.             end
  254.  
  255.         case keystroke == K_PGUP
  256.             if ( lAppend )
  257.                 lKillAppend := .t.
  258.             else
  259.                 oB:pageUp()
  260.             end
  261.  
  262.         case keystroke == K_CTRL_PGUP
  263.             if ( lAppend )
  264.                 lKillAppend := .t.
  265.             else
  266.                 oB:goTop()
  267.             end
  268.  
  269.         case keystroke == K_CTRL_PGDN
  270.             if ( lAppend )
  271.                 lKillAppend := .t.
  272.             else
  273.                 oB:goBottom()
  274.             end
  275.  
  276.         case keystroke == K_RIGHT
  277.             oB:right()
  278.  
  279.         case keystroke == K_LEFT
  280.             oB:left()
  281.  
  282.         case keystroke == K_HOME
  283.             oB:home()
  284.  
  285.         case keystroke == K_END
  286.             oB:end()
  287.  
  288.         case keystroke == K_CTRL_LEFT
  289.             oB:panLeft()
  290.  
  291.         case keystroke == K_CTRL_RIGHT
  292.             oB:panRight()
  293.  
  294.         case keystroke == K_CTRL_HOME
  295.             oB:panHome()
  296.  
  297.         case keystroke == K_CTRL_END
  298.             oB:panEnd()
  299.  
  300.         case keystroke == K_DEL
  301.             /* toggle deleted() flag */
  302.          oB:forceStable()
  303.             cAlias := Eval(bAlias, oB:colPos)
  304.             if ( !Empty(cAlias) )
  305.                 Select(cAlias)
  306.             end
  307.  
  308.             if ( Recno() != Lastrec() + 1 )
  309.             IF NetRLock()
  310.  
  311.                // We've got a lock...
  312.                // If the record is deleted, recall it, and vice-versa
  313.                IF DELETED()
  314.                   RECALL
  315.                ELSE
  316.                   DELETE
  317.                END
  318.  
  319.                COMMIT
  320.                UNLOCK
  321.  
  322.             ENDIF
  323.             end
  324.  
  325.             Select(nPrimeArea)
  326.  
  327.         case keystroke == K_INS
  328.             /*toggle insert mode */
  329.             tog_insert()
  330.  
  331.         case keystroke == K_RETURN
  332.             /* edit the current field */
  333.  
  334.          if bof() .and. eof() .and. !lAppend
  335.             keyboard chr( K_DOWN ) + chr( nextkey() )
  336.             loop
  337.          endif
  338.  
  339.          oB:forceStable()
  340.  
  341.             cAlias := Eval(bAlias, oB:colPos)
  342.  
  343.             if ( !Empty(cAlias) )
  344.                 Select(cAlias)
  345.             end
  346.  
  347.              if ( !lAppend .and. (Recno() == LastRec() + 1) )
  348.                 Select(nPrimeArea)
  349.                 loop    /* NOTE */
  350.             end
  351.  
  352.             Select(nPrimeArea)
  353.  
  354.             /* make sure the display is correct */
  355.             oB:hitTop := .f.
  356.             Statline(oB, lAppend, cAlias)
  357.          WHILE !oB:stabilize() ; END
  358.  
  359.             cEditField := &cFieldArray[oB:colPos]
  360.  
  361.             /* turn the cursor on */
  362.             SetCursor(1)
  363.             curs_on := .t.
  364.  
  365.             if ( Type(cEditField) == "M" )
  366.                 /* edit memo field */
  367.                 help_code := 19
  368.                 box_open := .t.
  369.  
  370.                 /* save, clear, and frame window for memoedit */
  371.                 cMemoBuff := SaveScreen(10, 10, 22, 69)
  372.  
  373.                 SetColor(color8)
  374.                 Scroll(10, 10, 22, 69, 0)
  375.                 @ 10, 10, 22, 69 BOX frame
  376.  
  377.                 /* use fieldspec for title */
  378.                 SetColor(color9)
  379.                 @ 10,((76 - Len(cEditField)) / 2) SAY "  " + cEditField + "  "
  380.  
  381.                 /* edit the memo field */
  382.                 SetColor(color8)
  383.                 cMemo := MemoEdit(&cEditField, 11, 11, 21, 68,.T.,"xmemo")
  384.  
  385.                 if Lastkey() == K_CTRL_END
  386.                     /* ^W..new memo confirmed */
  387.  
  388.                BEGIN SEQUENCE
  389.                   IF ( lAppend .and. Eof() )
  390.                      /* First data in new record */
  391.                      IF !NetAppBlank()
  392.                         BREAK    // Abort since we couldn't append
  393.                      ENDIF
  394.                   ELSE
  395.                      /* Just editing... */
  396.                      IF !NetRLock()
  397.                         BREAK    // Abort since we couldn't lock it
  398.                      ENDIF
  399.                   END
  400.  
  401.                   REPLACE &cEditField WITH cMemo
  402.                   COMMIT
  403.                   UNLOCK
  404.  
  405.                END SEQUENCE
  406.  
  407.                     /* move to next field */
  408.                     keystroke := K_RIGHT
  409.                     lGotKey := .t.
  410.                 else
  411.                     keystroke := 0
  412.                 end
  413.  
  414.                 /* restore the window */
  415.                 RestScreen(10, 10, 22, 69, cMemoBuff)
  416.                 box_open := .F.
  417.             else
  418.                 /* regular data entry */
  419.                 SetColor(color1)
  420.                 keystroke := DoGet(oB, lAppend, cAlias)
  421.                 lGotKey := ( keystroke != 0 )
  422.             end
  423.  
  424.          lKillAppend := .T.
  425.  
  426.             /* turn off the cursor unless append mode */
  427.             if ( !lAppend )
  428.                 SetCursor(0)
  429.                 curs_on := .f.
  430.             end
  431.  
  432.             help_code := nHelpSave
  433.             SetColor(color7)
  434.  
  435.         otherwise
  436.             if ( isdata(keystroke) )
  437.                 /* forward data keystroke to GET system */
  438.                 keyboard Chr(K_RETURN) + Chr(keystroke)
  439.             else
  440.                 /* check for menu request */
  441.                 sysmenu()
  442.  
  443.                 do case
  444.                 case q_check()
  445.                     /* exit */
  446.                     lMore := .f.
  447.  
  448.                 case local_func == 1
  449.                     /* help requested */
  450.                     DO syshelp
  451.  
  452.                 case local_func == 7
  453.                     /* move option selected..only the primary can be moved */
  454.                     nRec := Recno()
  455.                     move_ptr(aMoveExp, cPrimeDbf)
  456.  
  457.                     if ( nRec != Recno() )
  458.                         if ( lAppend )
  459.                             /* no more append mode */
  460.                             lKillAppend := .t.
  461.                         else
  462.                             FreshOrder(oB)
  463.                         end
  464.                     end
  465.                 end
  466.             end
  467.         end
  468.  
  469.         if ( lKillAppend )
  470.             /* turn off append mode */
  471.             lKillAppend := .f.
  472.             lAppend := .f.
  473.  
  474.             /* refresh respecting any change in index order */
  475.             FreshOrder(oB)
  476.             SetCursor(0)
  477.             curs_on := .f.
  478.       end
  479.  
  480.     end
  481.  
  482.     /* restore the screen */
  483.     RestScreen(8, 0, 23, 79, cBrowseBuf)
  484.     SetColor(nColorSave)
  485.     SetCursor(nCType)
  486.     curs_on := (nCType != 0)
  487.     stat_msg("")
  488.  
  489. return
  490.  
  491.  
  492. /***
  493. *    xmemo()
  494. *
  495. *    memoedit user function
  496. */
  497. func xmemo(mmode, line, col)
  498. local nRet
  499. memvar keystroke,local_func
  500.  
  501.     nRet := 0
  502.  
  503.     if mmode <> ME_IDLE
  504.         /* check for menu request */
  505.         keystroke := Lastkey()
  506.         sysmenu()
  507.  
  508.         do case
  509.         case local_func == 1
  510.             /* help requested */
  511.             do syshelp
  512.  
  513.         case keystroke == K_INS
  514.             /* insert key pressed */
  515.             tog_insert()
  516.             nRet := ME_IGNORE
  517.  
  518.         case keystroke == K_ESC
  519.             /* escape key pressed */
  520.             if mmode == ME_UNKEYX
  521.                 /* memo has been altered */
  522.                 if rsvp("Ok To Lose Changes? (Y/N)") <> "Y"
  523.                     /* no exit if not confirmed (32 == ignore) */
  524.                     nRet := ME_IGNORE
  525.                 end
  526.             end
  527.         end
  528.     end
  529.  
  530. return (nRet)
  531.  
  532.  
  533. /***
  534. *    tog_insert()
  535. *
  536. *    ditto
  537. */
  538. static func tog_insert
  539. local nCType
  540.  
  541.     Readinsert(!Readinsert())
  542.     nCType := SetCursor(0)
  543.     show_insert()
  544.     SetCursor(nCType)
  545.  
  546. return (0)
  547.  
  548.  
  549. /***
  550. *    show_insert()
  551. *
  552. *    display current insert mode
  553. */
  554. static func show_insert
  555. local nColorSave
  556.  
  557.     nColorSave := SetColor(color7)
  558.     @ 9,4 say if(ReadInsert(), "<Insert>", "        ")
  559.     SetColor(nColorSave)
  560.  
  561. return (0)
  562.  
  563.  
  564. /***
  565. *    statline()
  566. *
  567. *    update the status line in the browse window
  568. */
  569. static func statline(oB, lAppend, cAlias)
  570. local cColorSave, cCurrAlias, lNoFilter, nWaSave, nCType
  571.  
  572.     /* preserve current state */
  573.     nCType := SetCursor(0)
  574.  
  575.     nWaSave := Select()
  576.     if ( !Empty(cAlias) )
  577.         Select(cAlias)
  578.     end
  579.  
  580.     cColorSave := SetColor(color7)
  581.  
  582.     /* show current mode */
  583.     show_insert()
  584.  
  585.     /* show filter status */
  586.     lNoFilter := Empty(&("kf" + Substr("123456", Select(), 1)))
  587.     @ 9,16 say if(lNoFilter, "        ", "<Filter>")
  588.  
  589.     /* display record pointer information */
  590.     @ 9,41 say if(Empty(cAlias), space(10), Lpad(cAlias + "->", 10));
  591.                + "Record "
  592.  
  593.     if ( EmptyFile() .and. .not. lAppend )
  594.         /* file is empty */
  595.         @ 9,58 say "<none>               "
  596.     elseif ( Eof() )
  597.         /* no record number if eof */
  598.         @ 9,28 say "         "
  599.         @ 9,58 say "                " + if(lAppend, "<new>", "<eof>")
  600.     else
  601.         /* normal record..display recno()/lastrec() and deleted() */
  602.         @ 9,28 say if(Deleted(), "<Deleted>", "         ")
  603.         @ 9,58 say Pad(Ltrim(Str(Recno())) + "/" + Ltrim(Str(Lastrec())),15)+;
  604.                    If(oB:hitTop, " <bof>", if(oB:hitBottom, " <eof>", "      "))
  605.     end
  606.  
  607.     /* restore state */
  608.     SetColor(cColorSave)
  609.     Select(nWaSave)
  610.     SetCursor(nCType)
  611.  
  612. return (0)
  613.  
  614.  
  615. /***
  616. *    move_ptr()
  617. *
  618. *    seek, goto, locate, skip
  619. *
  620. *    the following array is defined and initialized in browse:
  621. *        aMoveExp[1] == the last SEEK expression
  622. *        aMoveExp[2] == the last GOTO value
  623. *        aMoveExp[3] == the last LOCATE expressions
  624. *        aMoveExp[4] == the last SKIP value
  625. */
  626. static func move_ptr(aMoveExp, cPrimeDbf)
  627.  
  628. local nHelpSave,aBox
  629. memvar okee_dokee, k_trim, movp_sel, titl_str, exp_label
  630. memvar help_code,local_sel,ntx_expr
  631. private okee_dokee, k_trim, movp_sel, titl_str, exp_label, ntx_expr
  632.  
  633.     nHelpSave := help_code
  634.  
  635.     /* save function select number */
  636.     movp_sel := local_sel
  637.  
  638.     /* initialize expression to previous value, if any */
  639.     k_trim := aMoveExp[movp_sel]
  640.  
  641.     /* set up for multibox */
  642.     aBox := Array(4)
  643.  
  644.     aBox[1] := "movp_title(sysparam)"
  645.     aBox[2] := "movp_exp(sysparam)"
  646.     aBox[3] := "ok_button(sysparam)"
  647.     aBox[4] := "can_button(sysparam)"
  648.  
  649.     do case
  650.     case movp_sel == 1
  651.         /* seek */
  652.         okee_dokee := "do_seek()"
  653.         titl_str := "Seek in file " + cPrimeDbf + "..."
  654.         exp_label := "Expression"
  655.         ntx_expr := Indexkey(0)
  656.         help_code := 13
  657.  
  658.     case movp_sel == 2
  659.         /* goto */
  660.         okee_dokee := "do_goto()"
  661.         titl_str := "Move pointer in file " + cPrimeDbf + " to..."
  662.         exp_label := "Record#"
  663.         help_code := 14
  664.  
  665.     case movp_sel == 3
  666.         /* locate */
  667.         okee_dokee := "do_locate()"
  668.         titl_str := "Locate in file " + cPrimeDbf + "..."
  669.         exp_label := "Expression"
  670.         help_code := 10
  671.  
  672.     case movp_sel == 4
  673.         /* skip */
  674.         okee_dokee := "do_skip()"
  675.         titl_str := "Skip records in file " + cPrimeDbf + "..."
  676.         exp_label := "Number"
  677.         help_code := 20
  678.     end
  679.  
  680.     /* do it */
  681.     set key K_INS to tog_insert
  682.     multibox(14, 17, 5, 2, aBox)
  683.     set key K_INS to
  684.  
  685.     /* save expression for next time */
  686.     aMoveExp[movp_sel] := k_trim
  687.  
  688.     help_code := nHelpSave
  689.  
  690. return (0)
  691.  
  692.  
  693. /***
  694. *    movp_title()
  695. *
  696. *    display title for move pointer functions
  697. */
  698. func movp_title(sysparam)
  699. memvar titl_str
  700. return (box_title(sysparam, titl_str))
  701.  
  702.  
  703. /***
  704. *    movp_exp()
  705. *
  706. *    get parameter for move pointer
  707. */
  708. func movp_exp(sysparam)
  709. memvar exp_label
  710. return (get_k_trim(sysparam, exp_label))
  711.  
  712.  
  713. /***
  714. *    do_seek()
  715. *
  716. *    seek to expression
  717. */
  718. func do_seek
  719.  
  720. local lDone, nRec, cSeekType
  721. memvar k_trim,ntx_expr
  722.  
  723.     lDone := .F.
  724.  
  725.     if Empty(k_trim)
  726.         error_msg("Expression not entered")
  727.     else
  728.         stat_msg("Searching...")
  729.  
  730.         /* save record number in case no find */
  731.         nRec := Recno()
  732.  
  733.         /* determine type for seek */
  734.         cSeekType := Type(ntx_expr)
  735.  
  736.         /* try it */
  737.         do case
  738.         case cSeekType == "C"
  739.             /* character search */
  740.             seek k_trim
  741.  
  742.         case cSeekType == "N"
  743.             /* numeric search */
  744.             seek Val(k_trim)
  745.  
  746.         case cSeekType == "D"
  747.             /* date search */
  748.             seek Ctod(k_trim)
  749.         end
  750.  
  751.         if Found()
  752.             /* operation complete */
  753.             stat_msg("Found")
  754.             lDone := .T.
  755.         else
  756.             /* consider this an error..start over */
  757.             error_msg("Not found")
  758.             goto nRec
  759.         end
  760.     end
  761.  
  762. return (lDone)
  763.  
  764.  
  765. /***
  766. *    do_goto()
  767. *
  768. *    go to record number
  769. */
  770. func do_goto
  771.  
  772. local lDone, nWhich
  773. memvar k_trim
  774.  
  775.     lDone := .F.
  776.     nWhich := Val(k_trim)        && convert to number
  777.  
  778.     do case
  779.     case Empty(k_trim)
  780.         error_msg("Record number not entered")
  781.  
  782.     case .not. Substr(Ltrim(k_trim), 1, 1) $ "-+1234567890"
  783.         error_msg("Record number not numeric")
  784.  
  785.     case nWhich <= 0 .or. nWhich > Lastrec()
  786.         error_msg("Record out of range")
  787.  
  788.     otherwise
  789.         /* operation complete */
  790.         goto nWhich
  791.         lDone := .T.
  792.  
  793.     end
  794.  
  795. return (lDone)
  796.  
  797.  
  798. /***
  799. *    do_locate()
  800. *
  801. *    locate expression
  802. */
  803. func do_locate
  804.  
  805. local lDone, nRec
  806. memvar k_trim
  807.  
  808.     lDone := .F.
  809.  
  810.     do case
  811.     case Empty(k_trim)
  812.         error_msg("Expression not entered")
  813.  
  814.     case Type(k_trim) <> "L"
  815.         error_msg("Expression Type must be Logical")
  816.  
  817.     otherwise
  818.         /* save record number in case no find */
  819.         nRec := Recno()
  820.         stat_msg("Searching...")
  821.  
  822.         if &k_trim
  823.             /* current record meets the condition */
  824.             skip
  825.         end
  826.  
  827.         /* search forward to end of file */
  828.         locate for &k_trim while .T.
  829.  
  830.         if Found()
  831.             /* operation complete */
  832.             stat_msg("Found")
  833.             lDone := .T.
  834.  
  835.         else
  836.             /* consider this an error..start over */
  837.             error_msg("Not found")
  838.             goto nRec
  839.         end
  840.     end
  841.  
  842. return (lDone)
  843.  
  844.  
  845. /***
  846. *    do_skip()
  847. *
  848. *    skip number of records
  849. */
  850. func do_skip
  851.  
  852. local lDone, nSkip
  853. memvar k_trim
  854.  
  855.     lDone := .F.
  856.     nSkip := Val(k_trim)        && convert to number
  857.  
  858.     do case
  859.     case Empty(k_trim)
  860.         error_msg("Skip value not entered")
  861.  
  862.     case .not. Substr(Ltrim(k_trim), 1, 1) $ "-+1234567890"
  863.         error_msg("Skip value not numeric")
  864.  
  865.     case nSkip == 0
  866.         error_msg("Skip value zero")
  867.  
  868.     otherwise
  869.         /* no out of range or over-skip error */
  870.         lDone := .T.
  871.  
  872.         skip nSkip
  873.  
  874.         if Eof()
  875.             /* over-skip..clear eof flag */
  876.             go bottom
  877.         end
  878.  
  879.         if Bof()
  880.             /* over-skip..clear bof flag */
  881.             go top
  882.         end
  883.     end
  884.  
  885. return (lDone)
  886.  
  887.  
  888. /***
  889. *    EmptyFile()
  890. */
  891.  
  892. static func EmptyFile()
  893.  
  894.     if (LastRec() == 0 )
  895.         return (.t.)
  896.     end
  897.  
  898.     if ( (Eof() .or. Recno() == LastRec() + 1) .and. Bof() )
  899.         return (.t.)
  900.     end
  901.  
  902. return (.f.)
  903.  
  904.  
  905. /***
  906. *    DoGet()
  907. *
  908. *    Edit the current field
  909. */
  910.  
  911. static func DoGet(oB, lAppend, cAlias)
  912.  
  913. local lExitSave, oCol, oGet, nKey, cExpr, xEval
  914. local lFresh, mGetVar, nWaSave
  915.  
  916.     /* save state */
  917.     lExitSave := Set(_SET_EXIT, .t.)
  918.     nWaSave := Select()
  919.     if ( !Empty(cAlias) )
  920.         Select(cAlias)
  921.     end
  922.  
  923.     /* set insert key to toggle insert mode and cursor */
  924.     set key K_INS to tog_insert
  925.     xkey_clear()
  926.  
  927.     /* get the controlling index key */
  928.     cExpr := IndexKey(0)
  929.     if ( !Empty(cExpr) )
  930.         /* expand key expression for later comparison */
  931.         xEval := &cExpr
  932.     end
  933.  
  934.     /* get column object from browse */
  935.     oCol := oB:getColumn(oB:colPos)
  936.  
  937.     /* use temp for safety */
  938.     mGetVar := Eval(oCol:block)
  939.  
  940.     /* create a corresponding GET with ambiguous set/get block */
  941.     oGet := GetNew(Row(), Col(),                                    ;
  942.                    {|x| if(PCount() == 0, mGetVar, mGetVar := x)},    ;
  943.                    "mGetVar")
  944.  
  945.    /* setup a scrolling GET if it's too long to fit on the screen */
  946.    if oGet:type == "C" .AND. LEN( oGet:varGet() ) > 78
  947.       oGet:picture := "@S78"
  948.    endif
  949.  
  950.     /* refresh flag */
  951.     lFresh := .f.
  952.  
  953.     /* read it */
  954.    BEGIN SEQUENCE
  955.       if ( ReadModal( {oGet} ) )
  956.          /* new data has been entered */
  957.          if ( lAppend .and. Recno() == LastRec() + 1 )
  958.             /* new record confirmed */
  959.             IF !NetAppBlank()
  960.                BREAK    // Let's bail out, we couldn't APPEND BLANK
  961.             ENDIF
  962.          end
  963.  
  964.          IF NetRLock()
  965.             Eval(oCol:block, mGetVar)  // Replace with new data
  966.          ELSE
  967.             BREAK                      // Abort change, we couldn't RLOCK()
  968.          ENDIF
  969.  
  970.          // We appended and/or locked successfully, so now we commit and unlock
  971.          COMMIT
  972.          UNLOCK
  973.  
  974.          /* test for change in index order */
  975.          if ( !Empty(cExpr) .and. !lAppend )
  976.             if ( xEval != &cExpr )
  977.                /* change in index key eval */
  978.                lFresh := .t.
  979.             end
  980.          end
  981.       end
  982.    END SEQUENCE
  983.  
  984.     Select(nWaSave)
  985.     if ( lFresh )
  986.         /* record in new indexed order */
  987.         FreshOrder(oB)
  988.  
  989.         /* no other action */
  990.         nKey := 0
  991.     else
  992.         /* refresh the current row only */
  993.         oB:refreshCurrent()
  994.  
  995.         /* certain keys move cursor after edit if no refresh */
  996.         nKey := ExitKey(lAppend)
  997.     end
  998.  
  999.     /* restore state */
  1000.     Set(_SET_EXIT, lExitSave)
  1001.     set key K_INS to
  1002.     xkey_norm()
  1003.  
  1004. return (nKey)
  1005.  
  1006.  
  1007. /***
  1008. *    ExitKey()
  1009. *
  1010. *    Determine the follow-up action after editing a field
  1011. */
  1012.  
  1013. static func ExitKey(lAppend)
  1014.  
  1015. memvar keystroke
  1016.  
  1017.     keystroke := LastKey()
  1018.     if ( keystroke == K_PGDN )
  1019.         /* move down if not append mode */
  1020.         if ( lAppend )
  1021.             keystroke := 0
  1022.         else
  1023.             keystroke := K_DOWN
  1024.         end
  1025.  
  1026.     elseif ( keystroke == K_PGUP )
  1027.         /* move up if not append mode */
  1028.         if ( lAppend )
  1029.             keystroke := 0
  1030.         else
  1031.             keystroke := K_UP
  1032.         end
  1033.  
  1034.     elseif ( keystroke == K_RETURN .or. isdata(keystroke) )
  1035.         /* return key or type out..move right */
  1036.         keystroke := K_RIGHT
  1037.  
  1038.     elseif (keystroke != K_UP .and. keystroke != K_DOWN .and. menu_key() == 0)
  1039.         /* no other action */
  1040.         keystroke := 0
  1041.     end
  1042.  
  1043. return (keystroke)
  1044.  
  1045.  
  1046. /***
  1047. *    FreshOrder()
  1048. *
  1049. *    Refresh respecting any change in index order
  1050. */
  1051.  
  1052. static func FreshOrder(oB)
  1053.  
  1054. local nRec
  1055.  
  1056.     nRec := Recno()
  1057.     oB:refreshAll()
  1058.  
  1059.     /* stabilize to see if TBrowse moves the record pointer */
  1060.    oB:forceStable()
  1061.  
  1062.     if ( nRec != LastRec() + 1 )
  1063.         /* record pointer may move if bof is on screen */
  1064.         while ( Recno() != nRec )
  1065.             /* falls through unless record is closer to bof than before */
  1066.          oB:up():forceStable()
  1067.         end
  1068.     end
  1069.  
  1070. return (NIL)
  1071.  
  1072.  
  1073. /***
  1074. *    Skipped(n)
  1075. *
  1076. *    Skip thru database and return the
  1077. *    actual number of records skipped
  1078. */
  1079.  
  1080. static func Skipped(nRequest, lAppend)
  1081.  
  1082. local nCount
  1083.  
  1084.     nCount := 0
  1085.     if ( LastRec() != 0 )
  1086.         if ( nRequest == 0 )
  1087.             skip 0
  1088.  
  1089.         elseif ( nRequest > 0 .and. Recno() != LastRec() + 1 )
  1090.             /* forward */
  1091.             while ( nCount < nRequest )
  1092.                 skip 1
  1093.                 if ( Eof() )
  1094.                     if ( lAppend )
  1095.                         /* eof record allowed if append mode */
  1096.                         nCount++
  1097.                     else
  1098.                         /* back to last actual record */
  1099.                         skip -1
  1100.                     end
  1101.  
  1102.                     exit
  1103.                 end
  1104.  
  1105.                 nCount++
  1106.             end
  1107.  
  1108.         elseif ( nRequest < 0 )
  1109.             /* backward */
  1110.             while ( nCount > nRequest )
  1111.                 skip -1
  1112.                 if ( Bof() )
  1113.                     exit
  1114.                 end
  1115.  
  1116.                 nCount--
  1117.             end
  1118.         end
  1119.     end
  1120.  
  1121. return (nCount)
  1122.  
  1123.  
  1124. /* eof dbuedit.prg */
  1125.